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MODULE COBSACC sett 


ABSTRACT 


1 
4 [DENT = "1-006" ! file: COBACCDWK.832 EDIT:MLJ1006 | 
é BEGIN | 
$ — TNE aC RaRRIRT ere EET ene | 
ie 2 
ie COPYRIGHT (c) 1978, 1980, 1982, 1984 B * 
ie DIGITAL QUIPRENT COR PORATION, MAYNARD. MASSACHUSETTS. « 
is ALL RIGHTS RESERVE e 
1g ie THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 
1 ie ONLY IN ACCORDANCE WITH THE TERMS OF such LICENS AND WITH THE ® 
14 ie INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * 
15 ie COPIES THEREOF MAY NOT BE PROVIDED OR BTHERUISE MADE AVAILABLE TO ANY * 
1 ie OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
is TRANSFERRED. - 
* 
8 THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOT ICE * 
0 ie SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
1 ie CORPORAT OW. ‘ 
5 ie DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * 
4 ie SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. e 
i 
$ —————— — ————— 
1 
i4 
5 


: 

i 

; 

i 

ENVIRONMENT: Vax-11 User Mode 

AUTHOR: MLJ , CREATION DATE: 16-JAN-1979 
MODIFIED BY: 
i 

i 

i 

i 

i 

; 

i 
ie 


1-001 = Original. MLJ 16-JAN-1979 
4 - Added boilerpt ate and comments. RKR KR 2A LY-1979 
1- - Declare yi, W. viet 850 aftere- RKR AUG -1979 
1- = Change RKR 1-0CT- 

1-005 - Cosmetic Mchenges, 


| 
' 
; FACILITY: COBOL SUPPORT | 
| 
| 
1 - Rewrite to use simplified algoritha. MLJ 02-Aug-81 | 
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—COONOUSWN—O 


'<BLF /PAGE> 


Soyer — GEt$60YMGLE SUINCHE UO. 


$ D0 1 ' 

; 0 i SWITCHES 

oO + 

3 DC 1 

; 0056 SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
3 Y 

3 305— 4 ' 

i 0 D059 1 | LINKAGES 

; 6¢ 061 1 | NONE 

3 6 006 1 ' 

; 64 D0¢ i TABLE OF CONTENTS: 

: 66 06 FORWARD ROUTINE 

3 68 i COBSACC_DAYWEEK : NOVALUE; 

: 70 0069 1°! INCLUDE FILES 

: 0 boro 1! 

is. d07¢ 1 REQUIRE "RTLIN:RTLPSECT® ; ! Macros for declaring psects 
> 2% 0167 1 LIBRARY "RTLSTARLE'; 

3 75 D1 1 

3 7 p18 1! 

aS 9170 1 ! MACROS 

: 28 0171 1 

; 9 1} NONE 

; 178 «1: 

: «81 0174 1 | EQUATED SYMBOLS 

; Q 0175 1 

; D176 1 i NONE 

3 0177 1! 

: 85 178 | PSECT DECLARATIONS: 

; D180 i DECLARE_PSECTS (COB) ; ! Psects for COBS facility 
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GLOBAL ROUTINE COBSACC_DAYWEEK(DST): NOVALUE= 


FUNCTIONAL DESCRIPTION 


Returns day_of_week as 1 = 7 corresponding to Mon. - Sun. 


FORMAL PARAMETERS: 


1 
i 
' 
i 
' 
: DST.wt.ds Address of descriptor of string to receive ans. 
{ IMPLICIT INPUTS: 
Date as supplied by SGETTIM. 
i IMPLICIT OUTPUTS: 
NONE 
1 
! ROUTINE VALUE: 
: COMPLETION CODES: 
NONE 
i 
SIDE EFFECTS: 
i 
—1 
= 
i 
BEGIN 
24 REF BLOCKC,BYTE); ! Pointer to destination descriptor 
SYSTIM: vECcToR(C2), ! Buffer for SGETTIM 
QUOTIENT ! Quotient from division 
REMAINDER, i Remainder (discarded) 
BUFFER; ! Buffer for output character 
BUILTIN 
EDIV; 
'¢ 
! Get the system date and time. Divide by the number of least significant 
! bits in 2 day (Bee x 3.8 o get the huaber of days — — —— 
! Bias this result to account for da being a Wednesday. Then, take th 
! result modulo 7 to get the day of the week such that Monday results in 0. 
! Finally, bias the result by ASCII °1° to get the answer as desired and 
; return it. 
SGETTIMCTINADReSYST m: 
EDIV(ZREF (1 >), SYSTIM, QUOTIENT, REMAINDER); ! Div by 10**9 
QUOTIENT = .QUOTIENT / : ! Finis 
BUFFER = ((.QUOTIENT + 2) MOD 7) + 2C'1"; 
5 la BUFFER, ZC° °, -OSTCOSC$W_LENGTH), -DSTCDSCSA_POINTER)); 


$251 


Page 


= Se een uenn nt 10:3) ECbantu’ sae Scobatciux 682: — 


-TITLE COBSACC_DAYWEEK 
IDE —2z8 


.ETRM SYSSGETTIM 
.PSECT _COBSCODE,NOWRT, SHR, PIC,2 


Se — Tae gies. Wey a DAYWEEK, Save R2,R3,R4,R5 : — 
50 Vvvoooooges Re saqaca i tp Ebivy 46 00000, 13 
. ane : 78 poly il 0 Ven YSTIM, QUOTIENT, REMAINDER : 0838 
1 1 §R EMUL'] duo orients =(SP) : 
i * | i lt 3 
i de At BO ae Se a}, oi : 0235 
60 20 6E 06 4 ze MOVCS #1, BUFFER, #32, (RO), @4(RO) ; 
04 RET : 0236 
Routine Size: 58 bytes, Routine Base: _COBSCODE + 0000 
128 $588 4 END ELUDOM 
PSECT SUMMARY 
Name Bytes Attributes 
_COBSCODE 58 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 
Library Statistics 
— Symbols -------- Pages Processing 
File Total Loaded Percent Mapped Time 
~5255$DUA28: CSYSLIBISTARLET.L32;1 9776 5 0 581 00:00.7 


COMMAND QUALIFIERS 
BLISS/CHECK=(FIELD, INITIAL OPTIMIZE) /NOTRACE/LIS=L1S$:COBACCDWK/0BJ=0BJ$:COBACCDWK MSRC$:COBACCDWK/UPDATE=(ENHS$: COBACCDWK 


— — — — — —— 
— — — — — — — — — — — — — — — — — — — 


FOBSACC DAYWEEK 


: Size: 58 + 0 data bytes 
Elapsed ii 18:8 

3 8 2 H ° 

34 2 Mins 

3 ponenne re wns 2 

; Memor 
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